perm filename RESTP.OLD[NEW,LCS] blob sn#258330 filedate 1977-12-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE RESTP
C00005 ENDMK
CāŠ—;
	SUBROUTINE RESTP
	COMMON /POSI/STFF(8),JJ2,JPQ /PX/KPN(1) /Q/Q(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
	COMMON/XRN/RN(1) /XXX/LK,LP,JY /JN/J,N
	1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
	DIMENSION MM(1),NN(1),RX(50)
	DATA IRST/0/
	EQUIVALENCE (MX,RX,RN(2650)),(MM,RN),(NN,RN(501))

	IF(IRST.EQ.0)GO TO 3
	IF(NN(1).NE.2)GO TO 4
C NEXT IS A REST
	IF(Q(MM(1)-3).LT.6)GO TO 4
C NEXT IS NUMBERED REST.
	Q(MM(1)+5)=Q(MM(1)+5)+RX(10)
	IRST=0
	GO TO 3

4	MX=MX-1
	CALL SHFTQ(RE)
C  PUSHES DATA TO RIGHT A BIT
	DO 9 K=KPN(JJ2-1),1,-1
9	Q(K+MX)=Q(K)
CC4	CALL RLOOP(Q(MX),Q,KPN(JJ2-1))
	LX=RX(MX+2)
C  THE WD CNT
CC	MX=MX-1
	RX(5)=ENDLN
10	CALL RLOOP(Q,RX(2),MX)
	DO 5 K=N,1,-1
	J=K+LX
	NN(J)=NN(K)
	MM(J)=MM(K)+MX
C  SHIFT EVERYTHING
5	KPN(J)=KPN(K)+MX
	N=N+LX
	JJ2=JJ2+LX
	KQ=KQ+MX
	J=2
	K=2
6	M=RX(K)+3
	KPN(J)=KPN(J-1)+M
	J=J+1
	K=K+M
	IF(K.LT.MX)GO TO 6
	IRST=0
	DO 7 K=1,LX
	MM(K)=KPN(K)+3
C  ASSUMES NO SLURS, HORIZ. LINES, ETC. AT THIS POINT.
7	NN(K)=CODEN(KPN,K,Q,J)

3	DO 1 K=N,1,-1
	J=NN(K)
	IF(J.GT.16)RETURN
	IF(J.EQ.1)RETURN
	IF(Q(MM(K)+1).GE.1000)RETURN
C  NO RESTS COMBINED OVER DOUBLE BARS.
	IF(J.NE.2)GO TO 1
	M=MM(K)
	IF(Q(M-3).LT.6)RETURN
	IRST=-1
C  NOW FOUND NUMBERED REST
	IF(K.NE.1)GO TO 8
	IRST=-2
C  -2 = ONLY RESTS ON THIS LINE.
8	M=1
	RE=ENDLN+3
	DO 2 J=K,N
	IF(NN(J).EQ.0)GO TO 2
C  DO I NEED THIS??
	JX=MM(J)
CC	Q(JX)=Q(JX)-200
	Q(JX)=RE
	RE=RE+3
	LX=Q(JX-3)+3
	JX=JX-4
	DO 2 JA=1,LX
	M=M+1
2	RX(M)=Q(JA+JX)
	MX=M
C WD CNT
	JJ2=JJ2-N+K-1
	RX(M+1)=N-K+1
	N=K-1
	IF(IRST.EQ.-2)N=-N
	RETURN
1	CONTINUE
	END